home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
DELPHI32
/
GRAPHICS
/
TS32
/
COLORPAN.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-03-16
|
13KB
|
413 lines
(***************************************************
TColorPanel->TCustomPanel
A panel that uses a palette handle provided by a
TColorPalette to render itself in 256 colors.
Properties
BlackOutline
Determines whether a single pixel, black outline will surround the control.
ColorIndex
The palette index of the panel's color.
ColorIndexFont
The palette index of the panel's font color.
ColorIndexFontDisabled
The palette index of the panel's font color when disabled.
ColorIndexFontRollover
The palette index of the panel's font color when the mouse is moved over
the control (if Rollover is TRUE).
ColorIndexHilight
The palette index of the panel's highlight border color.
ColorIndexShadow
The palette index of the panel's shadow border color.
ColorPalette
The TColorPalette component that this panel will use.
Rollover
Whether or not the panel supports a "rollover" effect when the mouse is
moved over it.
Procedures
ColorPanelActivate
The form should call this procedure in its OnActivate handler. It makes
sure that all TColorPanels are properly rendered.
ColorPanelMouseMove
Controls should call this procedure in their OnMouseMove handler. It handles
the rollover effect when moving off of TColorPanels.
***************************************************)
unit ColorPanel;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ColorPalette, DsgnIntf;
type
TColorPanel = class( TCustomPanel )
private
FBlackOutline: boolean;
FColorIndex: byte;
FColorIndexFont: byte;
FColorIndexFontDisabled: byte;
FColorIndexFontRollover: byte;
FColorIndexHilight: byte;
FColorIndexShadow: byte;
FColorPalette: TColorPalette;
FRollover: boolean;
FMouseOver: boolean;
protected
procedure Notification( AComponent: TComponent; Operation: TOperation ); override;
procedure MouseMove( Shift: TShiftState; X, Y: Integer ); override;
procedure Paint; override;
procedure SetBlackOutline( b: boolean );
procedure SetColorIndex( n: byte );
procedure SetColorIndexFont( n: byte );
procedure SetColorIndexFontDisabled( n: byte );
procedure SetColorIndexHilight( n: byte );
procedure SetColorIndexShadow( n: byte );
procedure SetColorPalette( cp: TColorPalette );
procedure SetMouseOver( b: boolean );
procedure CMEnabledChanged( var Message: TMessage ); message CM_ENABLEDCHANGED;
property MouseOver: boolean read FMouseOver write SetMouseOver;
public
constructor Create( AOwner: TComponent ); override;
published
property Align;
property Alignment;
property BevelOuter;
property BevelWidth;
property Caption;
property DragCursor;
property DragMode;
property Enabled;
property Font;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property BlackOutline: boolean read FBlackOutline write SetBlackOutline default TRUE;
property ColorIndex: byte read FColorIndex write SetColorIndex;
property ColorIndexFont: byte read FColorIndexFont write SetColorIndexFont;
property ColorIndexFontDisabled: byte read FColorIndexFontDisabled write SetColorIndexFontDisabled;
property ColorIndexFontRollover: byte read FColorIndexFontRollover write FColorIndexFontRollover;
property ColorIndexHilight: byte read FColorIndexHilight write SetColorIndexHilight;
property ColorIndexShadow: byte read FColorIndexShadow write SetColorIndexShadow;
property ColorPalette: TColorPalette read FColorPalette write SetColorPalette;
property Rollover: boolean read FRollover write FRollover default FALSE;
property OnClick;
property OnDblClick;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnEnter;
property OnExit;
property OnMouseDown;
property OnMouseMove;
property OnMouseUp;
property OnResize;
property OnStartDrag;
end;
TColorIndexEditor = class( TIntegerProperty )
private
protected
public
procedure Edit; override;
function GetAttributes: TPropertyAttributes; override;
end;
procedure ColorPanelMouseMove;
procedure ColorPanelActivate( frm: TForm );
procedure Register;
var
panelLastRolled: TColorPanel;
implementation
uses
ColorIndexEditor;
(***************************************************
OnActivate of the Form should call this procedure,
which makes sure all color panels are properly rendered.
***************************************************)
procedure ColorPanelActivate( frm: TForm );
var
i: integer;
begin
for i := 0 to frm.ComponentCount - 1 do
if frm.Components[i] is TColorPanel then
with frm.Components[i] as TColorPanel do
begin
if Visible then
Refresh;
end;
end;
(***************************************************
The other controls of the form should call this method
on their MouseMove events to ensure that the rollover
is properly terminated.
**************************************************)
procedure ColorPanelMouseMove;
begin
if panelLastRolled <> nil then
panelLastRolled.MouseOver := FALSE;
end;
(***************************************************
Set some defaults
***************************************************)
constructor TColorPanel.Create( AOwner: TComponent );
begin
inherited Create( AOwner );
FBlackOutline := TRUE;
FMouseOver := FALSE;
FRollover := FALSE;
end;
(***************************************************
Paint by using the specified color indices
***************************************************)
procedure TColorPanel.Paint;
var
nColor1, nColor2: byte;
nBlackOffset: integer;
rectDraw: TRect;
nFlags: integer;
begin
if Assigned( FColorPalette ) then
begin
SelectPalette( Canvas.Handle, FColorPalette.Palette, FALSE );
RealizePalette( Canvas.Handle );
Canvas.Brush.Style := bsSolid;
Canvas.Brush.Color := PaletteIndex( FColorIndex );
Canvas.FillRect( Canvas.ClipRect );
{ Determine which colors to use for left/upper and right/lower edges }
if BevelOuter = bvRaised then
begin
nColor1 := FColorIndexHilight;
nColor2 := FColorIndexShadow;
end
else
begin
nColor1 := FColorIndexShadow;
nColor2 := FColorIndexHilight;
end;
{ If the black border is drawm, offset all coords by 1 pixel }
if FBlackOutline then
nBlackOffset := 1
else
nBlackOffset := 0;
{ Draw the hilight }
Canvas.Pen.Style := psSolid;
Canvas.Pen.Width := BevelWidth * 2;
Canvas.Pen.Color := PaletteIndex( nColor1 );
Canvas.MoveTo( nBlackOffset, Height - 1 - nBlackOffset );
Canvas.LineTo( nBlackOffset, nBlackOffset );
Canvas.LineTo( Width - 1 + 1 - nBlackOffset, nBlackOffset );
{ Draw the shadow }
Canvas.Pen.Color := PaletteIndex( nColor2 );
Canvas.LineTo( Width - 1 + 1 - nBlackOffset, Height - 1 + 1 - nBlackOffset );
Canvas.LineTo( nBlackOffset, Height - 1 + 1 - nBlackOffset );
{ Draw the black border }
if FBlackOutline then
begin
Canvas.Brush.Style := bsClear;
Canvas.Pen.Color := PaletteIndex( 0 );
Canvas.Pen.Width := 1;
Canvas.Rectangle( 0, 0, Width - 1, Height - 1 );
end;
{ Draw the caption aligned within the client rectangle }
if Caption <> '' then
begin
case Alignment of
taCenter:
nFlags := DT_SINGLELINE or DT_VCENTER or DT_CENTER;
taLeftJustify:
nFlags := DT_SINGLELINE or DT_VCENTER or DT_LEFT;
taRightJustify:
nFlags := DT_SINGLELINE or DT_VCENTER or DT_RIGHT;
end;
Canvas.Font.Assign( Font );
if not Enabled then
Canvas.Font.Color := PaletteIndex( FColorIndexFontDisabled )
else if MouseOver and Rollover then
Canvas.Font.Color := PaletteIndex( FColorIndexFontRollover )
else
Canvas.Font.Color := PaletteIndex( FColorIndexFont );
rectDraw := ClientRect;
Canvas.Brush.Style := bsClear;
if BevelOuter = bvLowered then
OffsetRect( rectDraw, BevelWidth, BevelWidth );
DrawText( Canvas.Handle, PChar( Caption ), Length( Caption ), rectDraw, nFlags );
end;
end
else
inherited Paint;
end;
(***************************************************
When color properties change, refresh the control.
***************************************************)
procedure TColorPanel.SetBlackOutline( b: boolean );
begin
if FBlackOutline <> b then
begin
FBlackOutline := b;
Refresh;
end;
end;
procedure TColorPanel.SetColorIndex( n: byte );
begin
if FColorIndex <> n then
begin
FColorIndex := n;
Refresh;
end;
end;
procedure TColorPanel.SetColorIndexFont( n: byte );
begin
if FColorIndexFont <> n then
begin
if FColorIndexFontRollover = 0 then
FColorIndexFontRollover := n;
FColorIndexFont := n;
Refresh;
end;
end;
procedure TColorPanel.SetColorIndexFontDisabled( n: byte );
begin
if FColorIndexFontDisabled <> n then
begin
FColorIndexFontDisabled := n;
Refresh;
end;
end;
procedure TColorPanel.SetColorIndexHilight( n: byte );
begin
if FColorIndexHilight <> n then
begin
FColorIndexHilight := n;
Refresh;
end;
end;
procedure TColorPanel.SetColorIndexShadow( n: byte );
begin
if FColorIndexShadow <> n then
begin
FColorIndexShadow := n;
Refresh;
end;
end;
procedure TColorPanel.SetColorPalette( cp: TColorPalette );
begin
FColorPalette := cp;
Refresh;
end;
procedure TColorPanel.CMEnabledChanged(var Message: TMessage);
begin
inherited;
Refresh;
end;
(***************************************************
If the color panel is deleted, set property to nil.
***************************************************)
procedure TColorPanel.Notification( AComponent: TComponent; Operation: TOperation );
begin
if AComponent = FColorPalette then
if Operation = opRemove then
ColorPalette := nil;
end;
(***************************************************
Handle Rollover effect on MouseMove
***************************************************)
procedure TColorPanel.MouseMove( Shift: TShiftState; X, Y: Integer );
begin
inherited MouseMove( Shift, X, Y );
if panelLastRolled <> nil then
if panelLastRolled <> self then
panelLastRolled.MouseOver := FALSE;
MouseOver := TRUE;
panelLastRolled := self;
end;
procedure TColorPanel.SetMouseOver( b: boolean );
begin
if FMouseOver <> b then
begin
FMouseOver := b;
if Rollover then
Refresh;
end;
end;
(*********************************************
Property editors.
*********************************************)
procedure TColorIndexEditor.Edit;
var
cpSelf: TColorPalette;
begin
cpSelf := TColorPalette( TColorPanel( GetComponent( 0 ) ).ColorPalette );
if cpSelf = nil then
begin
ShowMessage( 'First assign a TColorPalette to the ColorPalette property' );
Exit;
end;
with TfrmColorIndexEditor.Create( nil ) do
begin
pal := cpSelf;
nIndex := GetOrdValue;
if ShowModal = mrOk then
SetOrdValue( nIndex );
Release;
end;
end;
function TColorIndexEditor.GetAttributes: TPropertyAttributes;
begin
Result := [paDialog];
end;
procedure Register;
begin
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndex', TColorIndexEditor );
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFont', TColorIndexEditor );
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFontDisabled', TColorIndexEditor );
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexFontRollover', TColorIndexEditor );
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexHilight', TColorIndexEditor );
RegisterPropertyEditor( TypeInfo( byte ), TColorPanel, 'ColorIndexShadow', TColorIndexEditor );
RegisterComponents( 'Vis', [TColorPanel] );
end;
end.